Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/filbx2/filebox.frm

Text File | 1995-05-08 | 11KB | 452 lines

VERSION 2.00
Begin Form FileBox
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Open File"
   ClientHeight    =   2775
   ClientLeft      =   3420
   ClientTop       =   945
   ClientWidth     =   5565
   Height          =   3180
   Icon            =   FILEBOX.FRX:0000
   Left            =   3360
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2775
   ScaleWidth      =   5565
   Top             =   600
   Width           =   5685
   Begin DirListBox Dir1
      Height          =   280
      Left            =   3930
      TabIndex        =   9
      Top             =   1320
      Visible         =   0   'False
      Width           =   1470
   End
   Begin ListBox List1
      Height          =   1395
      Left            =   2040
      TabIndex        =   5
      Top             =   1180
      Width           =   1815
   End
   Begin DriveListBox Drive1
      Height          =   360
      Left            =   3915
      TabIndex        =   8
      Top             =   980
      Visible         =   0   'False
      Width           =   1500
   End
   Begin FileListBox File1
      Height          =   1785
      Left            =   210
      TabIndex        =   3
      Top             =   820
      Width           =   1695
   End
   Begin CommandButton Cancel
      Cancel          =   -1  'True
      Caption         =   "Cancel"
      Height          =   360
      Left            =   4335
      TabIndex        =   7
      Top             =   560
      Width           =   1095
   End
   Begin CommandButton OK
      Caption         =   "OK"
      Default         =   -1  'True
      Height          =   360
      Left            =   4335
      TabIndex        =   6
      Top             =   120
      Width           =   1095
   End
   Begin TextBox Text1
      Height          =   300
      Left            =   1320
      TabIndex        =   1
      Text            =   "*.*"
      Top             =   140
      Width           =   2760
   End
   Begin Label Label4
      Caption         =   "&Directories:"
      Height          =   260
      Left            =   2070
      TabIndex        =   4
      Top             =   900
      Width           =   1530
   End
   Begin Label Label1
      Height          =   260
      Left            =   1950
      TabIndex        =   10
      Top             =   500
      Width           =   2160
   End
   Begin Label Label3
      Caption         =   "&Files:"
      Height          =   240
      Left            =   255
      TabIndex        =   2
      Top             =   480
      Width           =   825
   End
   Begin Label Label2
      Caption         =   "File &Name:"
      Height          =   260
      Left            =   285
      TabIndex        =   0
      Top             =   140
      Width           =   975
   End
End
'                               Filebox/Filebox2 by
'                                   Thomas Kiehl
'                                   P.O. Box 693
'                         Indian Rocks Beach, FL  34635
'
'                                  CIS: 73215,427
'
'
'This File Open Dialog Box Form and associated modules and forms are hereby released
'to the public domain to be used as seen fit by those who may use it, provided that
'such user understands that the author expresses no warranty, promise or claim of
'liability for its use, consequental use and/or damages to hardware, software or data.



DefInt A-Z

' FILEBOX declarations and constants


Dim LastChanged
Dim LastPattern As String
Dim CurrDir As String

Const ASCII_ENTER = 13
Const WM_USER = &H400
Const LB_RESETCONTENT = WM_USER + 5

Const TEXT_CHANGED = 0
Const FILE_CHANGED = 1
Const DIR_CHANGED = 2

Declare Function SendMessage% Lib "user" (ByVal hWnd%, ByVal wMsg%, ByVal wParam%, ByVal lParam&)
Declare Function GetFocus% Lib "user" ()
Declare Function PutFocus% Lib "user" Alias "SetFocus" (ByVal hWnd%)


Sub Cancel_Click ()
    Unload Filebox
End Sub

Sub ClearListBox (Ctrl As Control)

  If Ctrl.Visible Then
    hWndOld = GetFocus()
    list1.SetFocus
    x = SendMessage(GetFocus(), LB_RESETCONTENT, 0, 0)
    x = PutFocus(hWndOld)
  End If

End Sub

Sub Command1_Click ()
    Unload Filebox
End Sub

Sub Dir1_change ()

  ChDir (Dir1.path)
  file1.path = Dir1.path
  Label1.Caption = file1.path
  List1_Update

End Sub

Sub Drive1_Change ()

 On Error Resume Next

 Dir1.path = CurDir$(drive1.drive)
 If Err Then                'chances of an error getting here are slim
  MsgBox Error$
  drive1.drive = Dir1.path
 End If

 List1_Update

End Sub

Sub File1_Click ()

    LastChanged = FILE_CHANGED

    If file1.Listindex >= 0 Then    'zero based filename index
        text1.text = file1.filename
    End If
    If text1.text = "" Then
        OK.enabled = False
    Else
        OK.enabled = True
    End If

End Sub

Sub File1_DblClick ()

    LastChanged = FILE_CHANGED
    OK_Click

End Sub

Sub File1_KeyPress (KeyAscii As Integer)

    LastChanged = FILE_CHANGED
    If text1.text = "" Then
        OK.enabled = False
    Else
        OK.enabled = True
    End If

End Sub

Sub Form_Load ()

  Filebox.top = 1240
  Filebox.left = 2592
  Filebox.height = 3240
  Filebox.width = 5640

  LastPattern = "*.*"
  file1.Pattern = LastPattern
  List1_Update
  Label1.Caption = file1.path
  text1.selstart = 0
  text1.sellength = Len(text1.text)
  OK.enabled = True
  LastChanged = TEXT_CHANGED

End Sub

Sub List1_Click ()

  Dim startpos As Integer

  LastChanged = DIR_CHANGED
  OK.enabled = True

  If list1.text = "[..]" Then            ' Change to the parent directory
    text1.text = "..\" + file1.Pattern
  Else
    If Left$(list1.text, 2) = "[-" Then   ' This is a drive spec
        text1.text = Mid$(list1.text, 3, 1) + ":" + file1.Pattern
    Else ' This is a subdirectory of the current directory
        startpos = Len(CurrDir) + 2
        If list1.List(0) = "[..]" Then
            text1.text = Mid$(Dir1.List((list1.Listindex) - 1), startpos) + "\" + file1.Pattern
        Else
            text1.text = Mid$(Dir1.List(list1.Listindex), startpos - 1) + "\" + file1.Pattern
        End If
    End If
  End If

End Sub

Sub List1_Dblclick ()

  LastChanged = DIR_CHANGED
  If list1.text = "[..]" Then                     'the parent directory
    Dir1.path = Dir1.List(-2)
    Dir1_change
  Else
    If Left$(list1.text, 2) = "[-" Then           'this is a drive spec
      On Error GoTo list1_error
      Dummy$ = Dir$(Mid$(list1.text, 3, 1) + ":") 'error if door is open
                                                  'error has been trapped out
      drive1.drive = Mid$(list1.text, 3, 1) + ":" 'error if door is open (we did check it)
    Else                                          'sub directory
      If list1.List(0) = "[..]" Then              'we are not at root dir
        Dir1.path = Dir1.List((list1.Listindex) - 1)
      Else                                         'oh yes we are
        Dir1.path = Dir1.List(list1.Listindex)
      End If
      Dir1_change                                  'do the event
    End If
  End If
Exit Sub

list1_error:                                        'uh oh!

    Beep
    If Err = FILE_NOT_FOUND Then
        Button = MB_OK + MB_ICONEXCLAMATION
    Else
        Button = MB_ICONQUESTION + MB_RETRYCANCEL
    End If
    Button = MsgBox("ERROR: " + Error$(Err) + Str$(Err), Button, "FILE OPEN")
    If Button = IDRETRY Then
      Resume
    End If
    On Error GoTo 0
    Exit Sub

End Sub

Sub List1_Update ()

  ClearListBox list1
  CurrDir = Dir1.path

  If Len(CurrDir) > 3 Then
    list1.AddItem "[..]"
    DirPos = Len(CurrDir) + 2
  Else
    DirPos = 4
  End If

  For Count = 0 To Dir1.listcount - 1
    list1.AddItem "[" + Mid$(Dir1.List(Count), DirPos